perm filename KSIG.FAI[XX,LCS]2 blob
sn#217916 filedate 1976-05-31 generic text, type T, neo UTF8
00100 TITLE KSIG ; 00100 SUBROUTINE KSIG
00200 ENTRY KSIG,METER,MAKNUM
00210 EXTERNAL NOZERO,.COMM.,ITMSUB,POSI
00255 EXTERNAL ALPHA,IFIX,STF,AMOD,CENTX,SLUR,NOTWRT,CENTX
00400 KSIG: 0 ; FOR KEY SIGNATURES AND ACCENTS, ETC. (IN 'SCORE')
00500 ;00300 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,Z,H/STF/RSTFAC(-3/4),RSTJ2
00600 ;00400 C*******************;;;; Z WIPED OUT IN NOTWRT!!! BE CAREFUL WITH S!!!
00700 ;00500 EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
00800 ;00600 1,(R6,RJQ(4))
01000 MOVEI 02,11 ; JA=9
01100 MOVEM 2,.COMM.+1 ; C USES THIS KEY NUM IN NOTWRT
01300 ; COUNTER -- IZ=IABS(J5)
01400 MOVM 15,.COMM.+=26 ; NUMBER OF CALLS ON NOTWRT
01600 ; 01300 C THE CLEF NUM. IT GETS WIPED OUT IN NOTWRT.
01700 ; 01400 JW=1
01800 MOVEI 2,1
02000 ; 01500 R6=0
02100 SETZM .COMM.+7
02200 ; 01600 IF(J5.GT.0)JW=2
02300 SKIPLE .COMM.+=26
02400 AOS 2 ; 01700 C THE CODE FOR FLAT OR SHARP
02500 CAIGE 15,144 ; 01800 IF(IZ.LT.100)GO TO 5333
02600 JRST KS1
02700 MOVEI 2,3 ; 01900 JW=3
02900 SUBI 15,144 ; 02000 IZ=IZ-100
03000 ; 2100 WILL MAKE NATURALS IF 100 IS ADDED OR SUBTRACTED.
03110 KS1: MOVEM 2,JW# ; 02200 5333 CLEF=J6+1
03200 MOVE 4,.COMM.+=27
03300 MOVEM 4,CLEF#
03600 ;CLEF #S ARE 0,1,2,3 (TREB.,BA.,ALT.,TEN.)
03700 ; 02400 C CLEF NOW SET IN MAIN PROG.
03800 ; 02500 C IF NO CLEF GIVEN, TREBLE IS USED.
03900 ; 02600 T=10.
04000 MOVSI 13,204500 ; 13 IS T
04100 CAILE 4,1 ;2700 IF(CLEF.GT.1.)T=11.
04300 MOVSI 13,204540
04310 MOVEM 13,T#
04400 CAIN 4,3
04410 JRST KSX
04500 MOVNI 2,(4) ; 02800 S=3-CLEF
04510 ADDI 2,3
04520 SKIPA
04700 KSX: SETO 2, ; 02900 IF(CLEF.EQ.3)S=-1.
04800 TLC 2,232000
04900 FADR 2,2
04950 MOVEM 2,S#
05000 ; 03000 IF(J5.LT.0)GO TO 253
05100 MOVE 02,.COMM.+=26
05200 JUMPL 02,KS2
05300 ; 03100 W=-3.
05400 MOVN 02,[3.0]
05500 ; 03200 YY=4.
05600 MOVSI 3,203400
05700 ; 03300 Z=11.
05800 MOVSI 4,204540 ; 03400 C SHARPS
05900 ; 03500 GO TO 353
06000 JRST KS3
06100 ; 03600 253 W=-4
06200 KS2: MOVN 2,[4.0]
06300 ; 03700 YY=3.
06400 MOVSI 3,202600
06500 ; 03800 Z=7.
06600 MOVSI 4,203700 ; 03900 C FLATS
06700 KS3: MOVEM 2,W# ; 04000 353 N=-1
06800 MOVEM 3,YY#
06900 SETOM N#
07200 FADR 4,.COMM.+5 ;4100 Z=Z+R4
07300 MOVE .COMM.+4 ;RX=R3
07400 MOVEM RX#
08000 ; 04300 RA=0
08100 SETZM RA#
08200 ; 04400 C RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
08210 MOVSI 204640
08220 FMPR STF+=8
08230 MOVEM .COMM.+=27 ; SAVES IT IN J6
08300 MOVEM 15,IZ# ; 04500 DO 553 KA=1,IZ
08400 MOVEI 15,1
08500 ; 04600 J5=JW
08600 KS6: MOVE 02,JW
08700 MOVEM 02,.COMM.+=26
08800 ; 04700 R3=RX+RA
08900 MOVE 02,RX
09000 FADR 02,RA
09100 MOVEM 02,.COMM.+4
09200 ; 04800 RA=RA+13.*RSTJ2
09300 MOVE 02,.COMM.+=27
09500 FADRM 02,RA ; 04900 C MOVES OVER FOR NEXT ACCI.
09600 ; 05000 RD=Z
09800 MOVEM 4,RD#
09900 ; 05100 R4=Z
10000 MOVEM 4,.COMM.+5
10100 SKIPE CLEF ; 05200 IF(CLEF.NE.0)GO TO 7
10400 JRST KS7
10500 CAMG 4,[12.0] ;5300 IF(R4.GT.12.)R4=R4-7.
10800 JRST KS9
10900 MOVN 02,[7.0]
11000 FADRM 02,.COMM.+5
11100 ; 05400 GO TO 9
11200 JRST KS9
11300 ; 05500 7 R4=R4-S
11400 KS7: MOVN 02,S
11500 FADRB 02,.COMM.+5
11600 CAMG 2,T ; 05600 IF(R4.GT.T)R4=R4-7.
11700 JRST KS9
11800 MOVN 02,[7.0]
11900 FADRM 02,.COMM.+5 ;5700 ABOVE ARRANGES VERT. POS OF ACCIS.
12000 ; 05800 9 J4=R4
12100 KS9: JSA 16,IFIX
12200 JUMP .COMM.+5
12300 MOVEM 00,.COMM.+=25
12400 ; 05900 C FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
12600 JSA 16,CENTX
12800 JSA 16,NOTWRT
12900 ; 06200 Z=RD+W
13000 MOVE 4,W
13300 SKIPG N ; 06300 IF(N.GT.0)Z=RD+YY
13600 MOVE 4,YY ; N WAS -1 1ST TIME.
13700 FADR 4,RD
13900 ; 06400 553 N=-N
14000 MOVNS 00,N
14100 CAMGE 15,IZ
14200 AOJA 15,KS6
14300 JRA 16,(16) ; 06500 END
14400
15000 METER: 0 ;24300 SUBROUTINE METER
15600 ; 25100 CALL NOZERO(R7)
15700 JSA 16,NOZERO
15800 JUMP .COMM.+=8
15900 ; 25200 JZ=J3
16000 MOVE 02,.COMM.+=24
16100 MOVEM 02,JZ#
16200
16300 ; 25300 RY=R4+8.*.COMM.+=8
16400 MOVE 02,.COMM.+=8
16500 FSC 02,3
16600 FADRB 02,.COMM.+5
16700 MOVEM 02,RY#
16800 ; 26300 R4=RY
16900 ; 25400 C HEIGHT
17000 ; 25500 RW=R6
17100 MOVE 02,.COMM.+7
17200 MOVEM 02,RW#
17300 ; 25600 C BOTTOM NUM
17400 ; 25700 C P5=TOP NUM
17500 ; 25800 R6=.COMM.+=8
17600 MOVE 02,.COMM.+=8
17700 MOVEM 02,.COMM.+7
17800 ; 25900 RR6=R6
17900 MOVEM 02,RR6#
18000 ; 26000 C SIZE
18100 ; 26100 C FOR BDR40 -- OR =1
18200 ; 26200 M=0
18300 SETZM M#
18400 ; 26400 2 .COMM.+=8=0
18500 MT2: SETZM .COMM.+=8
18600 ; 26500 C .COMM.+=8=0 FOR BDR FONT??
18700 ; 26600 CC IF(R5.NE.99)GO TO 1
18800 ; 26700 IF(R5.LT.90)GO TO 3
18900 MOVSI 02,207550
19000 CAMLE 02,.COMM.+6
19100 JRST MT3
19200 ; 26800 C 99 AS METER = 'C' 98=ALLA BREVE (CUT TIME)
19300 ; 26900 M=-1
19400 SETOM M
19500 ; 27000 IF(R5.NE.98)GO TO 4
19600 MOVSI 02,207610
19700 CAME 02,.COMM.+6
19800 JRST MT4
19900 ; 27100 C NEXT FOR LINE THROUGH C.
20000 ; 27200 RZ=R6
20100 ;; MOVE 02,.COMM.+7
20200 ;; MOVEM 02,RZ#
20300 ; 27300 RY=R4
20400 ;; MOVE 02,.COMM.+5
20500 ;; MOVEM 02,RY
20600 ; 27400 RA=POS
20700 MOVE 02,POSI+=9
20800 MOVEM 02,RA#
20900 ; 27500 R6=RX3
21000 MOVE 02,.COMM.+=23
21100 MOVEM 02,.COMM.+7
21200 ; 27600 C TO LINE UP WITH R3
21300 ; 27700 J10=2
21400 MOVEI 02,2
21500 MOVEM 02,.COMM.+=31
21600 ; 27800 C FOR THICK LINE
21700 ; 27810 CC R5=9.8+R4
21800 ; 28000 R4=R4-3.8
21900 MOVN 02,[3.8]
22000 FADRB 02,.COMM.+5
22100 ; 28050 R5=R4+5.6
22200 FADR 02,[5.6]
22300 MOVEM 02,.COMM.+6
22400 ; 28100 J7=0
22500 SETZM .COMM.+=28
22600 ; 28200 R8=0
22700 SETZM .COMM.+=9
22800 ; 28300 CALL ITMSUB
22900 JSA 16,ITMSUB
23000 ; 28400 POS=RA
23100 MOVE 02,RA
23200 MOVEM 02,POSI+=9
23300 ; 28500 R4=RY
23400 MOVE 02,RY
23500 MOVEM 02,.COMM.+5
23600 ; 28600 R6=RZ
23700 MOVE 02,RR6
23800 MOVEM 02,.COMM.+7
23900 ; 28700 C GET BACK THE RIGHT PARAMS.
24000 ; 28900 4 R5=9999.
24100 MT4: MOVE 02,[9999.0]
24200 MOVEM 02,.COMM.+6
24300 ; 29100 C TO CENTER 12S AND 16S
24400 ; 29200 3 CALL MAKNUM(R5)
24500 MT3: JSA 16,MAKNUM
24600 JUMP .COMM.+6
24700 ; 29300 IF(M)RETURN
24800 SKIPGE M
24900 JRA 16,(16)
25000 ; 29400 C STICK AROUND FOR BOTTOM NUM
25100 ; 29500 M=-1
25200 SETOM M
25300 ; 29700 R6=RR6
25400 MOVE 02,RR6
25500 MOVEM 02,.COMM.+7
25600 ; 29600 R4=RY-4.*RR6
25700 FSC 02,2
25800 FSBR 02,RY
25900 MOVNM 02,.COMM.+5
26000 ; 29800 R5=RW
26100 MOVE 02,RW#
26200 MOVEM 02,.COMM.+6
26300 ; 29900 C GET BOTTOM NUM
26400 ; 30000 J3=JZ
26500 MOVE 02,JZ
26600 MOVEM 02,.COMM.+=24
26700 ; 30100 R8=0
26800 SETZM .COMM.+=9
26900 ; 30200 GO TO 2
27000 JRST MT2 ;30300 END
27100
27200
27300 MAKNUM: 0 ; SUBROUTINE MAKNUM(RNUM)
27400 ;100 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
27500 ;200 EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
27600 ;300 1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
27700 ;400 1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
27800 ;500 1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
27900 ;600 DATA RS/10.0/,RBX/1.0/
28000 MOVE 11,@(16) ;GET RNUM (KEEP 11 CLEAN IN OTHER ROUTINES)
28100 MOVE 02,.COMM.+=9 ; RB8=R8
28200 MOVEM 02,RB8#
28300 MOVE 02,.COMM.+=24 ; J3X=J3
28400 MOVEM 02,J3X# ; P7=0=BDR40; =1=BDI40; =2=PRIM.
28500 JSA 16,NOZERO ; CALL NOZERO(R6)
28600 JUMP .COMM.+7
28700 MOVE 02,.COMM.+7 ; R5=R6
28800 MOVEM 02,.COMM.+6 ; UPPER CASE - BDR40
28900 MOVSI 02,206620 ; R6=48000000.0+(R7+50.)*10000.
29000 FADR 02,.COMM.+=8
29100 FMPR 02,[10000.0]
29200 FADR 02,[48000000.0]
29300 MOVEM 02,.COMM.+7
29400 MOVE 02,[99999999.0] ; R7=99999999.0
29500 MOVEM 02,.COMM.+=8
29600 ; 32500 C BLANKS
29700 ; 32700 IF(RNUM.NE.9999.)GO TO 2
29800 CAME 11,[9999.0]
29900 JRST MN2
30000 ; 32800 C NEXT FOR 'C'OMMON TIME
30100 ; 32900 RNUM=12.
30200 MOVSI 11,204600
30300 ; 33000 C MAKES A 'C'
30400 ; 33100 R4=R4-2.2
30500 MOVN 02,[2.2]
30600 FADRM 02,.COMM.+5
30700 ; 33200 C .2 FOR BAD POS. OF LETTERS
30800 ; 33300 GO TO 4
30900 JRST MN4
31000 ; 33500 2 ONE=0
31100 MN2: SETZM ONE#
31200 ; 33600 RNUM=IFIX(RNUM)
31300 JSA 16,IFIX
31400 JUMP 11
31500 ;; MOVEM 11
31600 ;; JSA 16,FLOAT
31700 ;; JUMP 11
31800 MOVE 11,0
31900 TLC 11,232000
32000 FADR 11,11
32100 ; 33700 C SO MISTAKES (I.E. 2.2) WON'T BREAK THE PROG.
32200 ; 33800 IF(RNUM.EQ.1.)ONE=3.
32300 CAME 11,[1.0]
32400 JRST .+3
32500 MOVSI 02,202600
32600 MOVEM 02,ONE
32700 ; 33900 IF(RNUM.GT.9.)GO TO 3
32800 CAMLE 11,[9.0]
32900 JRST MN3
33000 ; 34000 C JUMP FOR 2 OR 3 DIGIT NUMBER
33100 ; 34100 4 R6=R6+RNUM*100.+47.
33200 ;;MN4: MOVSI 02,206570
33300 MN4: MOVSI 03,207620
33400 FMPR 03,11
33500 FADR 3,[47.0]
33600 FADRM 3,.COMM.+7
33700 ; 34200 C PUTS BLANK ON END (.47)
33800 ; 34300 GO TO 1
33900 JRST MN1
34000 ; 34500 3 RJY=10.
34100 MN3: MOVSI 3,204500 ; 3 NOW HAS RJY
34200 ;; MOVEM 02,RJY#
34300 CAML 11,[100.0] ; 34600 IF(RNUM.GE.100.)RJY=100.
34400 MOVSI 3,207620
34500 ;; MOVEM 03,RJY#
34600 ; 34700 B=IFIX(RNUM/RJY)
34700 MOVE 02,11
34800 ;; FDVR 02,RJY
34900 FDVR 2,3
35000 JSA 16,IFIX
35100 JUMP 2
35200 ;; MOVEM B
35300 ;; JSA 16,FLOAT
35400 ;; JUMP B#
35500 TLC 0,232000
35600 FADR 0,0
35700 MOVEM B
35800 ; 34800 C=AMOD(RNUM,RJY)
35900 JSA 16,AMOD
36000 JUMP 11
36100 JUMP 3
36200 MOVEM C#
36300 ; 34900 IF(RNUM.LT.100)GO TO 7
36400 CAMGE 11,[100.0]
36500 JRST MN7
36600 ; 35000 D=IFIX(C/10.)
36700 MOVE 02,C
36800 FDVR 02,[10.0]
36900 JSA 16,IFIX
37000 JUMP 2
37100 ;; MOVEM D
37200 ;; JSA 16,FLOAT
37300 ;; JUMP D
37400 TLC 0,232000
37500 FADR 0,0
37600 MOVEM D#
37700 ; 35100 C=AMOD(C,10.)
37800 JSA 16,AMOD
37900 JUMP C
38000 JUMP [10.0]
38100 MOVEM C
38200 ; 35200 IF(C.EQ.1.)ONE=ONE+3.
38300 CAME [1.0]
38400 JRST .+3
38500 MOVSI 02,202600
38600 FADRM 02,ONE
38700 ; 35300 R7=C*1000000.+999999.0
38800 FMPR 0,[1000000.0]
38900 FADR 0,[999999.0]
39000 MOVEM 0,.COMM.+=8
39100 ; 35400 C=D
39200 MOVE 02,D
39300 MOVEM 02,C
39400 ; 35500 7 R6=R6+B*100.+C
39500 ;;MN7: MOVE 02,.COMM.+7
39600 ;; FADR 02,C
39700 MN7: MOVSI 03,207620
39800 FMPR 03,B#
39900 FADR 3,C
40000 FADRM 3,.COMM.+7
40100 ; 35600 IF(B.EQ.1.)ONE=ONE+3.
40200 MOVSI 02,201400
40300 CAME 02,B
40400 JRST .+3
40500 MOVSI 3,202600
40600 FADRM 3,ONE
40700 ; 35700 IF(C.EQ.1.)ONE=ONE+3.
40800 CAME 02,C
40900 JRST .+3
41000 MOVSI 02,202600
41100 FADRM 02,ONE
41200 ; 35800 B=R5
41300 MOVE 02,.COMM.+6
41400 MOVEM 02,B
41500 ; 35900 IF(RNUM.GE.100.)B=B*2
41600 CAMGE 11,[100.0]
41700 JRST .+3
41800 MOVSI 02,202400
41900 FMPRB 02,B
42000 ; 36000 J3=J3-RS*RSTJ2*B
42100 FMPR 02,[10.0]
42200 FMPR 02,STF+=8
42300 JSA 16,IFIX
42400 JUMP 2
42500 SUB 0,.COMM.+=24
42600 MOVNM .COMM.+=24
42700 ; 36100 C FOR 2 DIGIT NUMBER
42800 ; 36600 C ADJUSTS FOR 11, ETC.
42900 ; 36900 1 J3=J3+ONE*R5*RSTJ2
43000 MN1: MOVE 02,.COMM.+6
43100 FMPR 02,ONE
43200 FMPR 02,STF+=8
43300 JSA 16,IFIX
43400 JUMP 2
43500 ADDM .COMM.+=24
43600 ; 37000 C CENTERS THE NUMBER '1'
43700 MOVEM 11,RNUM# ;37100 CALL ALPHA
43800 JSA 16,ALPHA
43900 ; 37200 J3=J3X
44000 MOVE 02,J3X#
44100 MOVEM 02,.COMM.+=24
44200 ; 37300 IF(RB8.EQ.0)RETURN
44300 SKIPN RB8
44400 JRA 16,1(16)
44500 ; 37400 C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
44600 MOVE 3,.COMM.+=24 ;37500 R3=J3-R5
44700 TLC 3,232000
44800 FADR 3,3
44900 FSBR 3,.COMM.+6
45000 MOVEM 3,.COMM.+4
45100 SKIPE .COMM.+=31 ;37600 IF(J10.EQ.0)J10=1
45200 JRST .+3
45300 MOVEI 02,1
45400 MOVEM 02,.COMM.+=31 ;USE J10 FOR EVEN THICKER BOX AND CIRC.
45500 ; 37800 IF(RNUM.GT.9)R3=R3+R5*RBX
45600 MOVE 11,RNUM ;GET BACK RNUM (11 WIPED OUT WHEN PLOTTING)
45700 CAMG 11,[9.0]
45800 JRST .+4
45900 MOVSI 02,201400
46000 FMPR 02,.COMM.+6
46100 FADRM 02,.COMM.+4
46200 ; 37900 C TO SET CENTER IF(RB8.EQ.2)GO TO 5
46300 MOVSI 02,202400
46400 CAMN 02,RB8
46500 JRST MN5
46600 MOVE 02,[0.05] ;38100 R4=R4+R5+.1+.05/R5
46700 FDVR 02,.COMM.+6
46800 FADR 2,[0.1]
46900 FADR 02,.COMM.+6
47000 FADRM 02,.COMM.+5
47100 ; 38200 C END OF ABOVE IS FOR SMALL CIRCLES.
47200 MOVSI 02,203440 ;38300 B=4.5
47300 ;; MOVEM 02,B
47400 ; 38400 IF(RNUM.GE.100.)B=5.5
47500 CAML 11,[100.0]
47600 ;; CAMLE 02,11
47700 ;; JRST .+3
47800 MOVSI 02,203540
47900 ;; MOVEM 02,B
48000 ; 38500 R5=R5*B
48100 ;; MOVE 02,B
48200 FMPRM 02,.COMM.+6
48300 ; 38600 JA=12
48400 MOVEI 02,14
48500 MOVEM 02,.COMM.+1
48600 ; 38700 J6=0
48700 SETZM .COMM.+=27
48800 ; 38800 J7=0
48900 SETZM .COMM.+=28
49000 ; 38900 J8=J10
49100 MOVE 02,.COMM.+=31
49200 MOVEM 02,.COMM.+=29 ;39000 CALL CENTX
49300 JSA 16,CENTX
49400 JSA 16,SLUR ;39100 CALL SLUR
49500 JRA 16,1(16) ;39200 RETURN
49600 ; 39400 5 JA=4
49700 MN5: MOVEI 02,4
49800 MOVEM 02,.COMM.+1
49900 ; 39500 B=6
50000 MOVSI 02,203600
50100 ;; MOVEM 02,B
50200 ; 39600 R9=0
50300 SETZM .COMM.+=10
50400 ; 39700 IF(RNUM.LT.100.)GO TO 8
50500 CAMGE 11,[100.0]
50600 JRST MN8
50700 ; 39800 B=9.
50800 MOVSI 02,204440
50900 ;; MOVEM 02,B
51000 ; 39900 R9=R5*6.
51100 MOVSI 1,203600
51200 FMPR 1,.COMM.+6
51300 MOVEM 1,.COMM.+=10
51400 ; 40000 C MAKES RECTANGLE IF ↑100
51500 ; 40100 8 R4=R4+R5*.7+.1
51600 MN8: MOVE 03,[0.7]
51700 FMPR 03,.COMM.+6
51800 FADR 3,[0.1]
51900 FADRM 3,.COMM.+5
52000 ; 40200 R8=R5*B
52100 ;; MOVE 02,.COMM.+6
52200 ;; FMPR 02,B
52300 FMPR 2,.COMM.+6
52400 MOVEM 02,.COMM.+=9
52500 ; 40300 J5=50
52600 MOVEI 02,62
52700 MOVEM 02,.COMM.+=26
52800 ; 40400 CALL ITMSUB
52900 JSA 16,ITMSUB
53000 ; 40500 C RETURNS ORIG. HORIZ. POS.
53100 JRA 16,1(16) ;40600 END
53200 END